perm filename PLT2.F4[1,LCS] blob
sn#579515 filedate 1981-04-11 generic text, type T, neo UTF8
C>BM=66 LM=1 TM=1 J=N
C******* PLT/FOR ****** LOAD WITH KEYIN/REL
C**** READS LIST OF X,Y COORDINATES. IF 3RD NUM.<>0 THEN JUMP.
EXTERNAL KEYIN
DIMENSION NN(3,500),MM(100)
REAL*8 NAME
INTEGER*1 CONEX,KEYIN,S,NA,ISTAR,MM,IBLA
DATA IBLA/' '/,S/'S'/
302 FORMAT(' TYPE ''S'' TO STOP PRINTING ')
89 FORMAT(' TYPE FILE NAME ')
300 WRITE(5,89)
REWIND 1
91 FORMAT(A8)
92 FORMAT(1XA8)
READ(5,91)NAME
WRITE(5,92)NAME
WRITE(5,93)
READ(5,1)JWIDTH
IF(JWIDTH.LT.80)JWIDTH=80
IF(JWIDTH.GT.100)JWIDTH=100
93 FORMAT(' TYPE NUMBER OF CHARACTERS WIDE ')
94 FORMAT(' TYPE X,Y SIZE FACTORS ')
95 FORMAT(2F6.3)
WRITE(5,94)
READ(5,95)XSIZE,YSIZE
IF(XSIZE.LT.0.1)XSIZE=1.
IF(YSIZE.LT.0.1)YSIZE=1.
WRITE(5,95)XSIZE,YSIZE
CALL OPEN(1,NAME,256)
WRITE(5,88)
READ(5,1)ISTAR
WRITE(5,30)ISTAR
96 FORMAT(' TYPE HORIZONTAL DISPLACEMENT ')
WRITE(5,96)
READ(5,1)JDIS
88 FORMAT(' TYPE CHARACTER NUMBER (42=*, 65=A) ')
1 FORMAT(3I4)
30 FORMAT(1X,3I4)
200 FORMAT(' 2=LPT, 5=CRT ')
WRITE(5,200)
READ(5,1)IDEV
IF(IDEV.EQ.5)JWIDTH=64
N=0
KK=1
WRITE(5,302)
100 READ(1,1,END=90)I,J,K
IF(I.LT.0)GO TO 90
C -1 ENDS INPUT
NN(3,KK)=K
A=I*XSIZE
I=A
C DO X,Y SCALING
A=J*YSIZE
J=A
IF(N.LT.J)N=J
C N HOLDS HIGHEST LINE NUMBER
NN(1,KK)=I+JDIS
NN(2,KK)=J
KK=KK+1
GO TO 100
90 DO 7 K=1,JWIDTH
7 MM(K)=IBLA
12 LL=1
KA=1
2 K=NN(1,LL)
L=NN(2,LL)
M=NN(3,LL)
IF(M.LT.0)GO TO 80
9 IF(M.EQ.0)GO TO 3
5 I=K
J=L
C SAVE PREVIOUS POINT
GO TO 80
10 I=1
IF(NN(3,LL+1).NE.0)I=-I
NN(3,LL)=I
C MARK SEGS ENTIRELY ABOVE CURRENT LINE.
GO TO 5
3 IF(L.LT.N.AND.J.LT.N)GO TO 5
IF(L.GT.N.AND.J.GT.N)GO TO 10
C JUMP IF BOTH Y COORDS ARE LOWER THAN THIS LINE.
8 X=K-I
IF(X.NE.0)GO TO 13
M=K
C VERTICAL LINE
IF(M.GT.JWIDTH)GO TO 5
IF(M.LT.1)GO TO 5
GO TO 14
13 Y=L-J
IF(Y.NE.0)GO TO 15
IF(K.GT.I)GO TO 16
JA=K
JB=I
GO TO 17
16 JA=I
JB=K
17 IF(JB.LT.1)GO TO 5
IF(JB.GT.JWIDTH)JB=JWIDTH
IF(JA.GT.JWIDTH)JA=JWIDTH
IF(JA.LT.1)JA=1
DO 18 M=JA,JB
18 MM(M)=ISTAR
C HORIZONTAL LINE
NN(3,LL)=1
M=JB
GO TO 19
C LENGTHS OF X AND Y SEGMENTS
15 IF(K.LT.I)GO TO 40
JK=K
JI=I
JJ=J
JL=L
GO TO 41
40 JK=I
JI=K
JJ=L
JL=J
JJ=L
41 X=JK-JI
Y=JL-JJ
UU=JI+.5
A=N-JJ
U=JJ+.5
H=Y/X
NA=0
DO 42 JC=JI,JK
V=JC-JI
LA=H*V+U
IF(LA.LT.N)GO TO 43
IF(LA.EQ.N)GO TO 45
IF(NA.LT.0)GO TO 44
NA=1
GO TO 42
43 IF(NA.GT.0)GO TO 44
NA=-1
GO TO 42
44 B=A/H+UU
M=B
GO TO 46
45 M=JC
46 NA=0
IF(M.GT.JWIDTH)GO TO 42
IF(M.LT.1)GO TO 42
MM(M)=ISTAR
IF(M.GT.KA)KA=M
42 CONTINUE
GO TO 5
14 MM(M)=ISTAR
C SOLID GRAPHICS CHAR.
19 IF(M.GT.KA)KA=M
IF(KA.GT.JWIDTH)KA=JWIDTH
GO TO 5
80 LL=LL+1
IF(LL.LT.KK)GO TO 2
C GO BACK AND LOOK AT MORE VECTORS
C WRITE(5,20)(MM(K),K=1,KA)
WRITE(IDEV,20)(MM(K),K=1,KA)
N=N-1
IF(KEYIN.NE.S)GO TO 301
IF(CONEX(N).NE.0)GO TO 300
301 IF(N.GE.0)GO TO 90
WRITE(IDEV,20)IBLA
C SO LAST REAL LINE WILL PRINT
20 FORMAT(1X,100A1)
END
C
FUNCTION CONEX(Q)
EXTERNAL KEYIN
INTEGER*1 J,CONEX,KEYIN,G,N,X
COMMON /KEY/X,N,G
C3 FORMAT(1X4A1)
2 FORMAT(' G=GO, N=NEW FILE, X=EXIT ')
WRITE(5,2)
CONEX=0
1 J=KEYIN
IF(J.EQ.G)RETURN
IF(J.EQ.X)STOP *DONE*
IF(J.NE.N)GO TO 1
C WRITE(5,3)J,X,N,G
CONEX=-1
RETURN
END
C
BLOCK DATA LTRS
INTEGER*1 X,N,G
COMMON /KEY/X,N,G
DATA X/'X'/,N/'N'/,G/'G'/
END